home *** CD-ROM | disk | FTP | other *** search
/ The Programmer Disk / The Programmer Disk (Microforum).iso / xpro / basic2 / pro7 / wdemo.bas < prev    next >
BASIC Source File  |  1989-01-06  |  19KB  |  605 lines
  1. DECLARE SUB ReadScreenDemo ()
  2. DECLARE SUB demo2 ()
  3. DECLARE SUB demo1 ()
  4. DECLARE SUB scrolltext ()
  5. DECLARE SUB SubPause ()
  6. DECLARE SUB PrintxDemo ()
  7. DECLARE SUB StringArray ()
  8. DECLARE SUB machine ()
  9. DECLARE SUB NewBorders ()
  10. DECLARE SUB SimError ()
  11. DECLARE SUB attributes ()
  12. DECLARE SUB Fill ()
  13. DECLARE SUB open10 ()
  14. DECLARE SUB train ()
  15. DECLARE SUB inc (n)
  16. DECLARE SUB dec (n)
  17.  
  18. '==================================================================
  19. REM $DYNAMIC
  20. REM $INCLUDE: 'Declare.Bas'
  21. '==================================================================
  22.  
  23. OPTION BASE 1
  24.  
  25. REDIM e$(100): CALL StringArray: 'initialize some strings for PrintxDemo
  26.  
  27.  
  28. '-----blank all four screens----
  29. COLOR 7, 0
  30. FOR page = 3 TO 0 STEP -1
  31. SCREEN , , page, page: CLS
  32. NEXT
  33.  
  34.  
  35. '----Initialize the string array for the main menu----
  36. RESTORE 100: REDIM m$(20)
  37. FOR x = 1 TO 20: READ m$(x): NEXT
  38.  
  39. '----print the menu----
  40. OpenW 2, 7, 0, 1, 1, 14, 80
  41. CALL FillW(0, VARPTR(m$(1)))
  42.  
  43. '------Define the active keys------
  44. exit$ = "sfvcdpbg"
  45.  
  46. '---------Main Menu starts here------
  47. start:
  48.  
  49. '----Wait for a keypress----
  50. i$ = "": DO UNTIL i$ <> "": i$ = INKEY$: LOOP
  51.  
  52. '---------all the demos use screen 1--------------------
  53. IF INSTR(exit$, i$) THEN
  54.         SCREEN , , 1, 0: 'Clear the screen before viewing it to
  55.         CLS : '            make the transition cleaner
  56.         SCREEN , , 1, 1: 'have basic view and print to screen 1
  57.         CALL SetViewPage(1): '   switch windows to screen 1
  58.         END IF
  59.  
  60. SELECT CASE i$
  61. CASE "s": CALL train: CALL machine
  62. CASE "f": CALL Fill
  63. CASE "v": CALL attributes
  64. CASE "c": CALL open10
  65. CASE "d": CALL SimError
  66. CASE "p": CALL PrintxDemo
  67. CASE "b": CALL NewBorders
  68. CASE "q": END
  69. CASE "g": CALL demo2: CALL scrolltext: CALL demo1
  70. CASE "r": CALL ReadScreenDemo
  71.  
  72. CASE ELSE
  73.  
  74. END SELECT
  75.  
  76. '--------------Restore the main menu by switching back to screen 0---------
  77. SCREEN , , 0, 0: CALL SetViewPage(0)
  78. GOTO start
  79.  
  80. '==========================================================================
  81.  
  82. 100 DATA  "   Examples",,"     S  Scrollx","     F  Fill Window"
  83. DATA "     V  View Attributes","     C  CloseLastW"
  84. DATA "     D  Call DebugW   ","     B  User defined borders"
  85. DATA "     P  Printx Demo  "
  86. DATA "     G  Scroll Left in Graphics Mode"
  87. DATA "     R  ReadScreen Demo"
  88. DATA "     Q  Quit"
  89. DATA ,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
  90.  
  91. 200 DATA ".eiee[] o---o o---o o---o o---o o---o o---o eee[]e                                                      "
  92.  
  93. ResumeNext: EE = ERR: RESUME NEXT
  94.  
  95. REM $STATIC
  96. '===========================================================================
  97.           SUB attributes STATIC
  98. CLS : DEF SEG = &HB900: 'segment of screen 1
  99. LOCATE 10, 30: PRINT "Decimal"; : LOCATE 20, 30: PRINT "Hex";
  100. LOCATE 25, 1: PRINT "Press any key to quit"
  101.  
  102. '----------------print all the a ttributes in decimal-----------
  103. LOCATE 1, 1, 0
  104. x = 0: DO UNTIL x = 127
  105.         PRINT USING "#####"; x;
  106.  
  107.         FOR y = 1 TO 9 STEP 2
  108.         POKE x * 10 + y, x
  109.         NEXT: i$ = INKEY$: IF i$ <> "" THEN EXIT DO
  110.         x = x + 1: LOOP
  111.  
  112. '-------Print all the attributes in hex-----------------
  113. LOCATE 11, 1
  114. x = 0: DO UNTIL x = 127
  115.         i$ = INKEY$: IF i$ <> "" THEN EXIT SUB
  116.         PRINT USING "\   \"; HEX$(x);
  117.  
  118.         FOR y = 1 TO 9 STEP 2
  119.         POKE x * 10 + y + 1600, x
  120.         NEXT: i$ = INKEY$: IF i$ <> "" THEN EXIT DO
  121.         x = x + 1: LOOP
  122.  
  123. Printt CHR$(10), 7, 25, 1: 'erase message
  124.  
  125. Printt "Press any key to call SwapAttr", 7, 20, 1
  126. CALL SubPause:
  127. Printt "Press any key to call SwapAttr", 7, 21, 1: CALL SwapAttr
  128.  
  129. CALL SubPause:
  130. Printt "Press any key to call ChangeAttr(15)", &H70, 22, 1: CALL SwapAttr
  131.  
  132. CALL SubPause:
  133. Printt "Press any key to call ChangeAttr(&h70)", 7, 23, 1
  134. CALL ChangeAttr(15)
  135.  
  136. CALL SubPause:
  137. Printt "Press any key to call SwapAttr" + CHR$(10), 15, 24, 1
  138. CALL ChangeAttr(&H70)
  139. CALL SubPause:
  140. CALL SwapAttr
  141. Printt "Press any key...", 7, 25, 1
  142.  
  143. CALL SubPause
  144.  
  145.  
  146. END SUB
  147.  
  148. SUB dec (n) STATIC
  149.         n = n - 1
  150. END SUB
  151.  
  152. SUB demo1 STATIC
  153. SCREEN 2, , 0, 0: CLS
  154. 'move a triangle wave
  155.  
  156. y = 86: z = -1
  157. LINE (0, 23)-(639, 23)
  158. LINE (0, 88)-(639, 88)
  159.  
  160. i$ = "": DO UNTIL i$ <> ""
  161.         FOR x = 632 TO 639
  162.         PSET (x, y)
  163.         y = y + z
  164.         IF y < 32 THEN z = 1 ELSE IF y > 86 THEN z = -1
  165.         NEXT x
  166.  
  167. CALL GScrollL8(24, 0, 87, 639)
  168.                      i$ = INKEY$:    LOOP
  169. RUN
  170. END SUB
  171.  
  172. SUB demo2 STATIC
  173. SCREEN 0, 1, 0, 0
  174. SCREEN 2: CLS
  175. 'rack up some balls
  176.        
  177.         CIRCLE (559, 50), 30:
  178. FOR y = 1 TO 66: CALL GScrollL8(20, 0, 80, 639): NEXT
  179.  
  180.         CIRCLE (559, 50), 30:
  181. FOR y = 1 TO 56: CALL GScrollL8(20, 80, 80, 639): NEXT
  182.        
  183.         CIRCLE (559, 50), 30:
  184.         FOR y = 1 TO 46: CALL GScrollL8(20, 160, 80, 639): NEXT
  185.        
  186.         CIRCLE (559, 50), 30:
  187. FOR y = 1 TO 36: CALL GScrollL8(20, 240, 80, 639): NEXT
  188. INPUT "Pause....."; x$
  189.  
  190. END SUB
  191.  
  192. REM $DYNAMIC
  193. SUB Fill STATIC
  194.         SHARED EE:       'error code from resumenext
  195. 'note that larger boxes don't print slower - all the time is taken by basic
  196. 'this routine prints tab character, may need to filter the file to expand them
  197. f$ = "WDemo.bas":
  198.         LOCATE 2, 21, 0: x$ = CHR$(220) + CHR$(220) + CHR$(220)
  199.         x$ = x$ + CHR$(221) + CHR$(32) + CHR$(222)
  200.         x$ = x$ + CHR$(223) + CHR$(223) + CHR$(223)
  201.         CALL defborder(x$):
  202. BeginFill:
  203. CLS
  204. PRINT "Scroll  "; CHR$(25); "  "; CHR$(26); "  "; CHR$(27); "  "; CHR$(24);
  205. PRINT "  PageUp  PageDown  Home  End  tab  shift/tab"
  206. PRINT "Change border  b"
  207. PRINT "New file  f"
  208. PRINT "Window size  + -"
  209. PRINT "Quit  <esc>"
  210.  
  211.         PgUp$ = CHR$(0) + CHR$(73): PgDn$ = CHR$(0) + CHR$(81)
  212.         Up$ = CHR$(0) + CHR$(72): down$ = CHR$(0) + CHR$(80)
  213.         lft$ = CHR$(0) + CHR$(75): rght$ = CHR$(0) + CHR$(77)
  214.         Ins$ = CHR$(0) + CHR$(82): del$ = CHR$(0) + CHR$(83): backspace$ = CHR$(0) + CHR$(8)
  215.         home$ = CHR$(0) + CHR$(71): end$ = CHR$(0) + CHR$(79): ShiftTab$ = CHR$(0) + CHR$(15)
  216.         cr$ = CHR$(13): esc$ = CHR$(27): tab$ = CHR$(9): esc$ = CHR$(27)
  217. r = 5: n = 0: lastline = 1: bb = 2
  218. xx = 2000: REDIM a%(xx): REDIM a$(1000)
  219. '-------------------------Load a text file to view--------------------------
  220. StartFill:
  221. EE = 0: ON ERROR GOTO ResumeNext
  222. '===========================================================================
  223. CLOSE : OPEN "i", #3, f$
  224. LOCATE 10, 30: PRINT "Loading "; f$
  225.  
  226. IF EE <> 0 THEN
  227.         CLOSE
  228.         IF f$ <> "" THEN LOCATE 10, 30: PRINT f$; " not found             ";
  229.         LOCATE 12, 1: PRINT SPC(79); : LOCATE 12, 1, 1
  230.         INPUT "Name of a text file to view  or  <enter> to quit  "; f$
  231.         IF f$ = "" THEN EXIT SUB ELSE GOTO StartFill
  232.         END IF
  233. ON ERROR GOTO 0
  234. PRINT TAB(30); "Press <Esc> to stop"
  235.         DO UNTIL EOF(3): LINE INPUT #3, a$(lastline)
  236.         LOCATE 9, 40: PRINT USING "####"; lastline
  237.         inc lastline
  238.         i$ = INKEY$: IF i$ = esc$ THEN EXIT DO
  239.         LOOP: CLOSE #3
  240. LOCATE 11, 30: PRINT SPC(79);
  241. '-------------------------Set up a window-----------------------------------
  242.  
  243. openWindow:
  244.        IF r < 1 THEN r = 1 ELSE IF r > 10 THEN r = 10
  245. CALL OpenW(bb, &H7, VARSEG(a%(1)), 11 - r, 36 - 3.5 * r, 14 + r, 45 + 3.5 * r)
  246.  
  247. '-------------------------Print the file in the window----------------------
  248. printwindow:
  249.         IF L > lastline - r * 2 THEN L = lastline - r * 2
  250.         IF L < 1 THEN L = 1
  251.         IF n < 0 THEN n = 0 ELSE IF n > 120 THEN n = 120
  252.         CALL FillW(n, VARPTR(a$(L)))
  253.  
  254.         i$ = "": DO UNTIL i$ <> "": i$ = INKEY$: LOOP
  255.  
  256. SELECT CASE i$
  257.         CASE "f", "F": f$ = "": GOTO BeginFill
  258.         CASE Up$: dec L
  259.         CASE down$: inc L
  260.         CASE lft$: inc n
  261.         CASE rght$: dec n
  262.         CASE "b": inc bb: IF bb = 5 THEN bb = 0: CALL CloseLastW: GOTO openWindow ELSE CALL CloseLastW: GOTO openWindow
  263.         CASE tab$: n = n + 5
  264.         CASE ShiftTab$: n = n - 5
  265.         CASE esc$:  ERASE a%: ERASE a$: EXIT SUB
  266.         CASE PgUp$: L = L - r * 2
  267.         CASE PgDn$: L = L + r * 2
  268.         CASE home$: n = 0: L = 1
  269.         CASE end$: L = 99000
  270.         CASE "-": dec r: CALL CloseLastW: GOTO openWindow
  271.         CASE "+": inc r: CALL CloseLastW: GOTO openWindow
  272.         CASE ELSE
  273. END SELECT: GOTO printwindow
  274.  
  275. END SUB
  276.  
  277. REM $STATIC
  278. SUB inc (n) STATIC
  279.         n = n + 1
  280. END SUB
  281.  
  282. REM $DYNAMIC
  283. '===========================================================================
  284.  SUB machine STATIC
  285. COLOR 0, 7: CLS
  286. LOCATE 3, 1:
  287. PRINT "                                             "
  288. PRINT "                                             "
  289. PRINT "     xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx"
  290. PRINT "   xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx"
  291. PRINT " xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx"
  292. PRINT " xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx     "
  293. PRINT "                                             "
  294. REDIM c%(800)
  295. CALL saveW(VARSEG(c%(1)), 3, 5, 9, 40)
  296.  
  297. LOCATE 3, 1
  298. PRINT "                                   xxxxxxxxxxxx"
  299. PRINT "                      xxxxxxxxxxxxxxxxxxxxxx   "
  300. PRINT "                xxxxxxxxxxxxxxxxxxxxxxxxx   "
  301. PRINT "           xxxxxxxxxxxxxxxxxxxxxxxx         "
  302. PRINT "      xxxxxxxxxxxxxxxxxxxxxxx                "
  303. PRINT "   xxxxxxxxxxxxxxxxxxxx                      "
  304. PRINT "xxxxxxxxxxxxx                                            "
  305.  
  306. REDIM ccc%(800)
  307. CALL saveW(VARSEG(ccc%(1)), 3, 5, 9, 40)
  308.  
  309.                    CLS
  310.  
  311.  
  312. CALL OpenW(0, 0, 0, 10, 50, 23, 54): 'Draw a black box
  313. LOCATE 24, 1, 0
  314. PRINT "                                                    A B C D E F G H I J K L M N";
  315. y = 97: DO UNTIL y = 123
  316. i$ = INKEY$: IF i$ <> "" THEN EXIT DO
  317. '----go left and up
  318. FOR pause = 1 TO 10: NEXT
  319. FOR x = 1 TO 7: CALL scrollL(&H70, 1, 1, 44, 23, 60): NEXT
  320. CALL closew(VARSEG(ccc%(1)), 2, 5, 8, 40): 'print arm in up position
  321. FOR x = 1 TO 10: CALL scrollu(&H70, 1, 1, 44, 23, 60): NEXT
  322.  
  323. '---go right and down
  324. FOR pause = 1 TO 10: NEXT
  325. FOR x = 1 TO 7: CALL scrollr(&H70, 1, 1, 44, 23, 60): NEXT
  326. CALL closew(VARSEG(c%(1)), 2, 5, 8, 40): 'print arm in down position
  327. FOR x = 1 TO 10: CALL scrolld(&H70, 1, 1, 44, 23, 60): NEXT
  328.  
  329. 'scroll the letters
  330. LOCATE 24, 52: PRINT CHR$(y); : ' small letter
  331. IF y < 110 THEN LOCATE 24, 79: PRINT CHR$(y - 19); : 'capital letter
  332.  
  333. CALL scrollL(&H70, 2, 24, 1, 25, 52)
  334. CALL scrollL(&H70, 2, 24, 53, 25, 79)
  335.  
  336. 'FOR pause = 1 TO 100: NEXT
  337. inc y: LOOP
  338.  
  339. FOR pause = 1 TO 250: NEXT
  340. COLOR 7, 0
  341. ERASE c%: ERASE ccc%
  342. END SUB
  343.  
  344. '===========================================================================
  345. SUB NewBorders STATIC
  346.         CLS
  347.         LOCATE 2, 1, 0: x$ = "123456789":
  348.         PRINT x$;
  349.         CALL defborder(x$):
  350.         CALL OpenW(4, &H3, 0, 4, 2, 8, 8)
  351.        
  352.         LOCATE 2, 21, 0: x$ = CHR$(220) + CHR$(220) + CHR$(220)
  353.         x$ = x$ + CHR$(221) + CHR$(32) + CHR$(222)
  354.         x$ = x$ + CHR$(223) + CHR$(223) + CHR$(223)
  355.         PRINT x$;
  356.         CALL defborder(x$):
  357.         CALL OpenW(4, &H3, 0, 4, 22, 8, 28)
  358.        
  359.         LOCATE 2, 41, 0: x$ = CHR$(236) + CHR$(240) + CHR$(236)
  360.         x$ = x$ + CHR$(177) + CHR$(32) + CHR$(177)
  361.         x$ = x$ + CHR$(236) + CHR$(240) + CHR$(236)
  362.         PRINT x$;
  363.         CALL defborder(x$):
  364.         CALL OpenW(4, &H3, 0, 4, 42, 8, 48)
  365.       
  366.         LOCATE 2, 61, 0: x$ = CHR$(176) + CHR$(176) + CHR$(176)
  367.         x$ = x$ + CHR$(219) + CHR$(32) + CHR$(219)
  368.         x$ = x$ + CHR$(176) + CHR$(176) + CHR$(176)
  369.         PRINT x$;
  370.         CALL defborder(x$):
  371.         CALL OpenW(4, &H3, 0, 4, 62, 8, 68)
  372.       
  373.                   INPUT x$
  374. END SUB
  375.  
  376. '===========================================================================
  377. SUB open10 STATIC
  378.         r = 2000
  379.         REDIM a%(r): REDIM b%(r): REDIM c%(r): REDIM d%(r): REDIM e%(r)
  380.         REDIM f%(r): REDIM g%(r): REDIM h%(r): REDIM i%(r): REDIM j%(r)
  381.         pause = 12
  382.  
  383.  
  384. CALL OpenW(2, &H70, VARSEG(a%(1)), 11, 36, 15, 44)
  385.         FOR x = 1 TO pause: NEXT
  386. CALL OpenW(2, &H70, VARSEG(b%(1)), 9, 34, 17, 48)
  387.         FOR x = 1 TO pause: NEXT
  388. CALL OpenW(2, &H70, VARSEG(c%(1)), 8, 29, 18, 52)
  389.         FOR x = 1 TO pause: NEXT
  390. CALL OpenW(2, &H70, VARSEG(d%(1)), 7, 25, 19, 56)
  391.         FOR x = 1 TO pause: NEXT
  392. CALL OpenW(2, &H70, VARSEG(e%(1)), 6, 21, 20, 60)
  393.         FOR x = 1 TO pause: NEXT
  394. CALL OpenW(2, &H70, VARSEG(f%(1)), 5, 17, 21, 64)
  395.         FOR x = 1 TO pause: NEXT
  396. CALL OpenW(2, &H70, VARSEG(g%(1)), 4, 13, 22, 68)
  397.         FOR x = 1 TO pause: NEXT
  398. CALL OpenW(2, &H70, VARSEG(h%(1)), 3, 9, 23, 72)
  399.         FOR x = 1 TO pause: NEXT
  400. CALL OpenW(2, &H70, VARSEG(i%(1)), 2, 5, 24, 76)
  401.         FOR x = 1 TO pause: NEXT
  402. CALL OpenW(2, &H70, VARSEG(j%(1)), 1, 1, 25, 80)
  403. FOR x = 1 TO 200: NEXT
  404.  
  405. FOR x = 1 TO 10:
  406.         CALL CloseLastW:
  407.         FOR xx = 1 TO 20: NEXT
  408.         NEXT
  409.  
  410. '-------------------------------------------------
  411. CALL OpenW(2, &H70, VARSEG(a%(1)), 1, 1, 15, 20)
  412.         FOR x = 1 TO pause: NEXT
  413. CALL OpenW(2, &H2, VARSEG(b%(1)), 2, 4, 16, 24)
  414.         FOR x = 1 TO pause: NEXT
  415. CALL OpenW(2, &H3, VARSEG(c%(1)), 3, 8, 17, 28)
  416.         FOR x = 1 TO pause: NEXT
  417. CALL OpenW(2, &H5, VARSEG(d%(1)), 4, 12, 18, 32)
  418.         FOR x = 1 TO pause: NEXT
  419. CALL OpenW(2, &H6, VARSEG(e%(1)), 5, 16, 19, 36)
  420.         FOR x = 1 TO pause: NEXT
  421. CALL OpenW(2, &H7, VARSEG(f%(1)), 6, 20, 20, 40)
  422.         FOR x = 1 TO pause: NEXT
  423. CALL OpenW(2, 10, VARSEG(g%(1)), 7, 24, 21, 44)
  424.         FOR x = 1 TO pause: NEXT
  425. CALL OpenW(2, 11, VARSEG(h%(1)), 8, 28, 22, 48)
  426.         FOR x = 1 TO pause: NEXT
  427. CALL OpenW(2, 14, VARSEG(i%(1)), 9, 32, 23, 52)
  428.         FOR x = 1 TO pause: NEXT
  429. CALL OpenW(2, 91, VARSEG(j%(1)), 10, 36, 24, 56)
  430. FOR x = 1 TO 200: NEXT
  431.  
  432. FOR x = 1 TO 10:
  433.         CALL CloseLastW:
  434.         FOR xx = 1 TO 20: NEXT
  435.         NEXT
  436.  
  437. ERASE a%: ERASE b%: ERASE c%: ERASE d%: ERASE e%: ERASE f%:
  438. ERASE g%: ERASE h%: ERASE i%: ERASE j%:
  439. END SUB
  440.  
  441. REM $STATIC
  442. SUB pages STATIC
  443. 'tests if printx prints to correct pages
  444.  
  445. FOR x = 0 TO 3: SCREEN , , x, x: CLS : NEXT
  446. SCREEN , , 1, 1: CALL SetViewPage(1)
  447. CALL OpenW(2, &H77, 0, 5, 5, 20, 40)
  448. CALL PrintW("Hello", 7, 2, 2)
  449.  
  450. CALL SetViewPage(0): CALL Printt("Page0", 7, 10, 10)
  451. CALL SetViewPage(1): CALL Printt("Page1", 7, 10, 10)
  452. CALL SetViewPage(2): CALL Printt("Page2", 7, 10, 10)
  453. CALL SetViewPage(3): CALL Printt("Page3", 7, 10, 10)
  454.  
  455.  
  456. FOR x = 0 TO 3: SCREEN , , x, x: PRINT "Page "; x; : INPUT x$: NEXT
  457. FOR x = 0 TO 3: SCREEN , , x, x: PRINT "Page "; x; : INPUT x$: NEXT
  458. END
  459.  
  460. END SUB
  461.  
  462. SUB PrintxDemo STATIC
  463.         SHARED e$()
  464. CALL SetViewPage(1): SCREEN , , 1, 1
  465.  
  466. FOR px = 1 TO 3:     'Once for each type of call
  467.  
  468. '---------------------------initialize the screen--------------------
  469. CLS :
  470.         FOR x = 1 TO 16: LOCATE x, 6: PRINT x; : NEXT
  471.         LOCATE 17, 1: FOR x = 1 TO 6: PRINT "1234567890"; : NEXT
  472.         Printt "Next string to print is", 7, 18, 1
  473.         LOCATE 3, 1
  474.                 IF px = 1 THEN PRINT "Call to PrintW"
  475.                 IF px = 2 THEN PRINT "Call to PrintW $ + chr$(13)"
  476.                 IF px = 3 THEN PRINT "Call to PrintW $ + chr$(10)"
  477.  
  478. '----------------------initialize the window-------------------------------
  479.         attr% = &H70: r% = 5: c% = 11
  480.         tr = 4: lc = 10: br = 16: rc = 66
  481.         CALL OpenW(2, 7, 0, tr, lc, br, rc)
  482. 'CALL temp
  483. '---print R, C, and the next string to be printed and locate the cursor----   
  484.         FOR x = 1 TO 13
  485.         LOCATE 1, 40, 0: PRINT "R% = "; r%; "   C% = "; c%
  486.         rr% = 19: cc% = 1
  487.         Printt e$(x), &H70, rr%, cc%
  488.  
  489.         Printt CHR$(13), &H7, rr%, cc%
  490.         Printt CHR$(13), &H7, rr%, cc%
  491.         IF r% = 16 THEN LOCATE 22, 1: PRINT "Note the cursor goes out of bounds instead of scrolling the last line"
  492.         LOCATE r%, c%, 1, 1, 12:   'block cursor
  493.                   'if window has no border, use this formula:
  494.                   'LOCATE r% + tr - 1, c% + lc - 1, 1, 1, 12
  495.  
  496.  
  497.        
  498. '------------------------Pause, then make the call to PrintW---------------   
  499.         i$ = "": DO UNTIL i$ <> "": i$ = INKEY$: LOOP
  500.  
  501.         IF px = 1 THEN PrintW e$(x), attr%, r%, c%
  502.         IF px = 2 THEN PrintW e$(x) + CHR$(13), attr%, r%, c%
  503.         IF px = 3 THEN PrintW e$(x) + CHR$(10), attr%, r%, c%
  504.         'IF px = 3 AND x = 8 THEN PrintW e$(x) + CHR$(10), attr%, r%, c%
  505.         NEXT
  506. NEXT px
  507. END SUB
  508.  
  509. SUB scrolltext STATIC
  510. SCREEN 2, 0, 0, 0: CLS
  511. 'characters in screen 2 are 8 by 8 so it is easy to scroll one char at a time
  512. 'draw a pattern
  513. FOR x = 1 TO 20
  514. PRINT "Hello 1 2 3 4 5 6 7 8 9 0 q w e r t y u i o p z x c v b n m , . / a s h j k l []"
  515. NEXT
  516.  
  517. 'define the window size where row (a&c) is 1 to 25 and columns (b & d)
  518. 'are 1 to 80
  519. a = 3: b = 1: c = 6: d = 80
  520.  
  521. 'convert rows & columns to 0-199 and 0-639 format
  522. tr = (a - 1) * 8: lc = (b - 1) * 8: br = c * 8 - 1: rc = (d - 1) * 8
  523.  
  524. PRINT tr, lc, br, rc: INPUT "Pause....."; x$
  525.  
  526. 'scroll 8 characters left
  527. CALL GScrollL8(tr, lc, br, rc)
  528. CALL GScrollL8(tr, lc, br, rc)
  529. CALL GScrollL8(tr, lc, br, rc)
  530. CALL GScrollL8(tr, lc, br, rc)
  531. CALL GScrollL8(tr, lc, br, rc)
  532. CALL GScrollL8(tr, lc, br, rc)
  533. CALL GScrollL8(tr, lc, br, rc)
  534. CALL GScrollL8(tr, lc, br, rc)
  535. INPUT "Pause....."; x$
  536. END SUB
  537.  
  538. '===========================================================================
  539. SUB SimError STATIC
  540.         CALL DebugW
  541. END SUB
  542.  
  543. SUB StringArray
  544.         SHARED e$()
  545.         OPEN "i", #3, "declare.bas"
  546.         FOR x = 1 TO 30
  547.         LINE INPUT #3, e$(x)
  548.         NEXT
  549. END SUB
  550.  
  551. SUB SubPause
  552.         i$ = "": DO UNTIL i$ <> "": i$ = INKEY$: LOOP
  553. END SUB
  554.  
  555. REM $DYNAMIC
  556. '===========================================================================
  557. SUB train STATIC
  558.  
  559. CLS : pause = 4
  560. PRINT "          f/faster   s/slower  esc/quit          delay ="
  561.         LOCATE 1, 60: PRINT USING "###"; pause;
  562. RESTORE 200: READ x$
  563. FOR x = 1 TO LEN(x$)
  564. LOCATE 10, 80
  565. PRINT MID$(x$, x, 1);
  566. CALL scrollL(&H7, 1, 10, 1, 10, 80)
  567. CALL scrolld(&H7, 1, 1, 5, 16, 5)
  568. CALL scrollr(7, 1, 16, 1, 16, 80)
  569. CALL scrollu(7, 1, 10, 80, 16, 80)
  570. NEXT
  571. DO
  572. CALL scrollL(&H7, 1, 10, 1, 10, 80)
  573. CALL scrolld(&H7, 1, 1, 5, 16, 5)
  574. CALL scrollr(7, 1, 16, 1, 16, 80)
  575. CALL scrollu(&H7, 1, 10, 80, 16, 80)
  576. FOR y = 1 TO pause: NEXT
  577. i$ = INKEY$:
  578.         IF i$ = CHR$(27) THEN EXIT DO
  579. IF i$ <> "" THEN GOSUB TrainKeyPress
  580. LOOP
  581. xs = 16: yy = 0
  582. FOR x = 1 TO 250
  583.         'IF yy = 46 GOTO ExitTrain
  584.         y = SCREEN(16, 79)
  585.         'LOCATE 1, 1: PRINT y: INPUT x$
  586.          IF y = 46 THEN xs = 15: x = 200: yy = 46
  587. ExitTrain:
  588. CALL scrollL(&H7, 1, 10, 1, 10, 80)
  589. CALL scrolld(&H7, 1, 1, 5, 16, 5)
  590. CALL scrollr(7, 1, 16, 1, 16, 80)
  591. CALL scrollu(&H7, 1, 10, 80, xs, 80)
  592. 'LOCATE 20, 1: PRINT y; : PRINT " "; SCREEN(16, 80): INPUT x$
  593. NEXT
  594.  
  595. EXIT SUB
  596.  
  597. TrainKeyPress:
  598.         IF i$ = "f" AND pause > 0 THEN dec pause
  599.         IF i$ = "s" AND pause < 100 THEN inc pause
  600.         LOCATE 1, 60: PRINT USING "###"; pause;
  601.         RETURN
  602.  
  603. END SUB
  604.  
  605.